home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / lisp / elk-2_0.lha / elk-2.0 / src / main.c < prev    next >
Encoding:
C/C++ Source or Header  |  1992-10-26  |  6.6 KB  |  297 lines
  1. #include "scheme.h"
  2.  
  3. #ifdef INCLUDE_UNISTD_H
  4. #  include <unistd.h>
  5. #endif
  6. #include TIME_H
  7. #ifndef MAX_STACK_SIZE
  8. #  include <sys/resource.h>
  9. #endif
  10. #include <sys/types.h>
  11. #include <sys/param.h>
  12. #include <sys/stat.h>
  13. #include <sys/file.h>
  14.  
  15. extern char *getenv();
  16.  
  17. char *stkbase;
  18. int Max_Stack;
  19. int Interpreter_Initialized;
  20. int GC_Debug = 0;
  21. int Case_Insensitive;
  22. int Verbose;
  23.  
  24. char **Argv;
  25. int Argc, First_Arg;
  26.  
  27. #if defined(USE_LD) || defined(CAN_DUMP) || defined(INIT_OBJECTS)
  28. char *A_Out_Name;
  29. char *Find_Executable();
  30. #endif
  31.  
  32. #if defined(CAN_LOAD_OBJ) || defined(INIT_OBJECTS)
  33. SYMTAB *The_Symbols;
  34. #endif
  35.  
  36. void Exit_Handler () {
  37. #if defined(CAN_LOAD_OBJ) || defined(INIT_OBJECTS)
  38.     Call_Finalizers ();
  39. #endif
  40. #ifdef USE_LD
  41.     Finit_Load ();
  42. #endif
  43. }
  44.  
  45. #ifndef ATEXIT
  46. void exit (n) {
  47.     Exit_Handler ();
  48.     _cleanup ();
  49.     _exit (n);
  50. }
  51. #endif
  52.  
  53. #ifdef CAN_DUMP
  54. int Was_Dumped;
  55. #endif
  56.  
  57. /* To avoid that the stack copying code overwrites argv if a dumped
  58.  * copy of the interpreter is invoked with more arguments than the
  59.  * original a.out, move the stack base INITIAL_STK_OFFSET bytes down:
  60.  */
  61.  
  62. main (ac, av) char **av; {
  63. #ifdef CAN_DUMP
  64.     char unused[INITIAL_STK_OFFSET];
  65. #endif
  66.     register char *initfile, *loadfile = 0, *loadpath = 0;
  67.     register debug = 0, heap = HEAP_SIZE;
  68.     Object file;
  69.     char foo;
  70.  
  71.     if (ac == 0) {
  72.     av[0] = "Elk"; ac = 1;
  73.     }
  74.     Get_Stack_Limit ();
  75.  
  76. #if defined(USE_LD) || defined(CAN_DUMP) || defined(INIT_OBJECTS)
  77.     A_Out_Name = Find_Executable (av[0]);
  78. #endif
  79.  
  80.     Argc = ac; Argv = av;
  81.     First_Arg = 1;
  82. #ifdef CAN_DUMP
  83.     if (Was_Dumped) {
  84.     Loader_Input[0] = '\0';
  85.     Install_Intr_Handler ();
  86.     (void)Funcall_Control_Point (Dump_Control_Point, Arg_True, 0);
  87.     /*NOTREACHED*/
  88.     }
  89. #endif
  90.  
  91.     for ( ; First_Arg < ac; First_Arg++) {
  92.     if (strcmp (av[First_Arg], "-g") == 0) {
  93.         debug = 1;
  94.     } else if (strcmp (av[First_Arg], "-i") == 0) {
  95.         Case_Insensitive = 1;
  96.     } else if (strcmp (av[First_Arg], "-v") == 0) {
  97.         Verbose = 1;
  98.     } else if (strcmp (av[First_Arg], "-h") == 0) {
  99.         if (++First_Arg == ac)
  100.         Usage ();
  101.         heap = atoi (av[First_Arg]);
  102.     } else if (strcmp (av[First_Arg], "-l") == 0) {
  103.         if (++First_Arg == ac || loadfile)
  104.         Usage ();
  105.         loadfile = av[First_Arg];
  106.     } else if (strcmp (av[First_Arg], "-p") == 0) {
  107.         if (++First_Arg == ac || loadpath)
  108.         Usage ();
  109.         loadpath = av[First_Arg];
  110.     } else if (strcmp (av[First_Arg], "--") == 0) {
  111.         First_Arg++;
  112.         break;
  113.     } else if (av[First_Arg][0] == '-') {
  114.         Usage ();
  115.     } else {
  116.         break;
  117.     }
  118.     }
  119.  
  120.     stkbase = &foo;
  121.     ALIGN(stkbase);
  122.     Make_Heap (heap);
  123.     Init_Everything ();
  124. #ifdef ATEXIT
  125.     if (atexit (Exit_Handler) != 0)
  126.     Fatal_Error ("atexit returned non-zero value");
  127. #endif
  128. #ifdef INIT_OBJECTS
  129.     if (Should_Init_Objects ()) {
  130.     Error_Tag = "init-objects";
  131.     The_Symbols = Open_File_And_Snarf_Symbols (A_Out_Name);
  132.     (void)Call_Initializers (The_Symbols, (char *)0);
  133.     }
  134. #endif
  135.     if (loadpath)
  136.     Init_Loadpath (loadpath);
  137.     
  138.     Error_Tag = "scheme-init";
  139.     initfile = INITFILE;
  140.     file = Make_String (initfile, strlen (initfile));
  141.     (void)General_Load (file, The_Environment);
  142.  
  143.     Install_Intr_Handler ();
  144.  
  145.     Error_Tag = "top-level";
  146.     if (loadfile == 0)
  147.     loadfile = "toplevel";
  148.     file = Make_String (loadfile, strlen (loadfile));
  149.     Interpreter_Initialized = 1;
  150.     GC_Debug = debug;
  151.     if (loadfile[0] == '-' && loadfile[1] == '\0')
  152.     Load_Source_Port (Standard_Input_Port);
  153.     else
  154.     (void)General_Load (file, The_Environment);
  155.     return 0;
  156. }
  157.  
  158. static char *Usage_Msg[] = {
  159.     "Options:",
  160.     "   [-l filename]   Load file instead of standard toplevel",
  161.     "   [-l -]          Load from standard input",
  162.     "   [-h heapsize]   Heap size in KBytes",
  163.     "   [-p loadpath]   Initialize load-path (comma-list of directories)",
  164.     "   [-g]            Enable GC-debugging",
  165.     "   [-i]            Case-insensitive symbols",
  166.     "   [-v]            Verbose mode (print linker commands)",
  167.     "   [--]            End options and begin arguments",
  168.     0 };
  169.  
  170. Usage () {
  171.     char **p;
  172.  
  173.     fprintf (stderr, "Usage: %s [options] [arguments]\n", Argv[0]);
  174.     for (p = Usage_Msg; *p; p++)
  175.     fprintf (stderr, "%s\n", *p);
  176.     exit (1);
  177. }
  178.  
  179. Init_Everything () {
  180.     Init_String ();
  181.     Init_Symbol ();
  182.     Init_Env ();
  183.     Init_Error ();
  184.     Init_Exception ();
  185.     Init_Io ();
  186.     Init_Prim();
  187.     Init_Math ();
  188.     Init_Print ();
  189.     Init_Auto ();
  190.     Init_Heap ();
  191.     Init_Load ();
  192.     Init_Proc ();
  193.     Init_Special ();
  194.     Init_Read ();
  195.     Init_Features ();
  196.     Init_Terminate ();
  197. #ifdef CAN_DUMP
  198.     Init_Dump ();
  199. #endif
  200. }
  201.  
  202. Get_Stack_Limit () {
  203. #ifdef MAX_STACK_SIZE
  204.     Max_Stack = MAX_STACK_SIZE;
  205. #else
  206.     struct rlimit rl;
  207.  
  208.     if (getrlimit (RLIMIT_STACK, &rl) == -1) {
  209.     perror ("getrlimit");
  210.     exit (1);
  211.     }
  212.     Max_Stack = rl.rlim_cur;
  213. #endif
  214.     Max_Stack -= STACK_MARGIN;
  215. }
  216.  
  217. #if defined(USE_LD) || defined(CAN_DUMP) || defined(INIT_OBJECTS)
  218. Executable (fn) char *fn; {
  219.     struct stat s;
  220.  
  221.     return stat (fn, &s) != -1 && (s.st_mode & S_IFMT) == S_IFREG
  222.         && access (fn, X_OK) != -1;
  223. }
  224.  
  225. char *Find_Executable (fn) char *fn; {
  226.     char *path, *getenv();
  227.     static char buf[1025];  /* Can't use Path_Max or Safe_Malloc here */
  228.     register char *p;
  229.  
  230.     for (p = fn; *p; p++) {
  231.     if (*p == '/') {
  232.         if (Executable (fn))
  233.         return fn;
  234.         else
  235.         Fatal_Error ("%s is not executable", fn);
  236.     }
  237.     }
  238.     if ((path = getenv ("PATH")) == 0)
  239.     path = ":/usr/ucb:/bin:/usr/bin";
  240.     do {
  241.     p = buf;
  242.     while (*path && *path != ':')
  243.         *p++ = *path++;
  244.     if (*path)
  245.         ++path;
  246.     if (p > buf)
  247.         *p++ = '/';
  248.     strcpy (p, fn);
  249.     if (Executable (buf))
  250.         return buf;
  251.     } while (*path);
  252.     Fatal_Error ("cannot find pathname of %s", fn);
  253.     /*NOTREACHED*/
  254. }
  255. #endif
  256.  
  257. Object P_Command_Line_Args () {
  258.     Object ret, tail;
  259.     register i;
  260.     GC_Node2;
  261.  
  262.     ret = tail = P_Make_List (Make_Fixnum (Argc-First_Arg), Null);
  263.     GC_Link2 (ret, tail);
  264.     for (i = First_Arg; i < Argc; i++, tail = Cdr (tail)) {
  265.     Object a = Make_String (Argv[i], strlen (Argv[i]));
  266.     Car (tail) = a;
  267.     }
  268.     GC_Unlink;
  269.     return ret;
  270. }
  271.  
  272. Object P_Exit (argc, argv) Object *argv; {
  273.     exit (argc == 0 ? 0 : Get_Integer (argv[0]));
  274.     /*NOTREACHED*/
  275. }
  276.  
  277. #ifdef INIT_OBJECTS
  278.  
  279. /* Returns true if DONT_INIT is not defined or if it is defined and
  280.  * argv[0] is not equal to DONT_INIT and doesn't end in a slash followed
  281.  * by DONT_INIT:
  282.  */
  283. Should_Init_Objects () {
  284. #ifdef DONT_INIT
  285.     register char *dont = DONT_INIT;
  286.     register alen = strlen (A_Out_Name), dlen = strlen (dont);
  287.  
  288.     return strcmp (A_Out_Name, dont) != 0 &&
  289.     !(alen > dlen && A_Out_Name[alen-dlen-1] == '/' &&
  290.             strcmp (A_Out_Name + alen - dlen, dont) == 0);
  291. #else
  292.     return 1;
  293. #endif
  294. }
  295.  
  296. #endif /* INIT_OBJECTS */
  297.